home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Tech Arsenal 1
/
Tech Arsenal (Arsenal Computer).ISO
/
tek-02
/
sortdemo.zip
/
SORTDEMO.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1992-04-15
|
11KB
|
293 lines
(*
╔═══════════════════════════════════════════════════════════════════════════╗
║ Turbo Pascal 6.0 Source File : SORTDEMO.PAS ║
╟───────────────────────────────────────────────────────────────────────────╢
║ Program : SORTDEMO ║
╟───────────────────────────────────────────────────────────────────────────╢
║ Version : 1.0 ║
╟───────────────────────────────────────────────────────────────────────────╢
║ Copyright (c) 1992 by Jon S. Russell ║
╟───────────────────────────────────────────────────────────────────────────╢
║ Demonstration of various sorting algorithms. Requires VGA (uses mode 13h, ║
║ 320x200x256 colors). ║
║ ║
║ Since the reason for creating this program is to demonstrate sorting ║
║ algorithms, and due to the many different aspects involved in writing ║
║ this program, the source code has been broken down into several include ║
║ files to make it easier to find the desired section of code for studying. ║
║ ║
║ The include files are... ║
║ ║
║ SDGRAF .INC == basic graphics routines ║
║ SDKEY .INC == keyboard routines ║
║ SDTIME .INC == time-keeping routines ║
║ SDFILE .INC == file related routines ║
║ SDDISP .INC == info-display & menuing routines ║
║ SDMISC .INC == misc routines ║
║ SDSORT01.INC == bubble sort routine ║
║ SDSORT02.INC == short-bubble sort routine ║
║ SDSORT03.INC == selection sort routine ║
║ SDSORT04.INC == merge sort routine ║
║ SDSORT05.INC == quick sort #1 routine ║
║ SDSORT06.INC == quick sort #2 routine ║
║ SDSORT07.INC == heap sort routine ║
║ ║
╚═══════════════════════════════════════════════════════════════════════════╝
*)
program SortDemo;
{$M 65520, 0, 655360} (* StackSize, HeapMin, HeapMax *)
uses
Crt, Dos, Graph, BGIFont;
(*
╔═══════════════════════════════════════════════════════════════════════════╗
║ GLOBAL DECLARATIONS ║
╚═══════════════════════════════════════════════════════════════════════════╝
┌───────────────────────────────────────────────────────────────────────────┐
│ sort-info declarations │
└───────────────────────────────────────────────────────────────────────────┘
*)
const
MaxNumElements = 8000;
type
IndexType = 0..MaxNumElements;
MethodType = (Bubble,ShortBubble,Selection,Merge,Quick1,Quick2,Heap);
OperationType = (Mix, Sort, Quit);
ListElemType = record
Key : longint; (* field to be sorted on *)
Color : byte; (* designates block color *)
end; (* ListElemType *)
ListType = array[1..MaxNumElements] of ListElemType;
InfoType = record
xElems : word; (* # of block rows *)
yElems : word; (* # of block columns *)
Len : IndexType; (* effective size of array *)
Method : MethodType; (* sorting method to use *)
Operation : OperationType; (* operation to perform *)
Save : boolean; (* save info to file toggle *)
Sorted : boolean; (* status flag *)
List : ListType; (* the array to be sorted *)
end; (* ListType *)
var
Info : InfoType;
(*
┌───────────────────────────────────────────────────────────────────────────┐
│ sort-titles declarations │
└───────────────────────────────────────────────────────────────────────────┘
*)
const
NumTitles = 7;
type
SortTitlesType = array[1..NumTitles] of string;
const
SortTitles : SortTitlesType = (
'Bubble Sort',
'Short Bubble',
'Selection Sort',
'Merge Sort',
'QuickSort #1',
'QuickSort #2',
'Heap Sort');
(*
┌───────────────────────────────────────────────────────────────────────────┐
│ time-keeping declarations │
└───────────────────────────────────────────────────────────────────────────┘
*)
type
TimeType = record
Hour : word;
Minute : word;
Second : word;
Sec100 : word;
end; (* TimeType *)
DateType = record
Year : word;
Month : word;
Day : word;
DayOfWeek : word;
end; (* DateType *)
TimeDateType = record
Time : TimeType;
Date : DateType;
end; (* TimeDateType *)
DiffType = record
Days : word;
Hours : word;
Minutes : word;
Seconds : word;
Sec100s : word;
end; (* DiffType *)
(*
┌───────────────────────────────────────────────────────────────────────────┐
│ keyboard declatations │
└───────────────────────────────────────────────────────────────────────────┘
*)
type
KeyRecType = record
Extended : boolean;
Ch : char;
end; (* KeyRecType *)
const
UpArrowKey = #072; (* extended *)
DnArrowKey = #080; (* extended *)
LfArrowKey = #075; (* extended *)
RtArrowKey = #077; (* extended *)
EnterKey = #013; (* non-extended *)
var
KeyRec : KeyRecType;
(*
┌───────────────────────────────────────────────────────────────────────────┐
│ graphics-related declarations │
└───────────────────────────────────────────────────────────────────────────┘
*)
const
xMax = 320;
yMax = 200;
type
ColorsType = record
Red : byte;
Grn : byte;
Blu : byte;
end; (* ColorsType *)
PaletteType = array[0..255] of ColorsType;
var
DefaultPalette : PaletteType;
Palette : PaletteType;
OldExitProc : pointer;
(*
┌───────────────────────────────────────────────────────────────────────────┐
│ include files │
└───────────────────────────────────────────────────────────────────────────┘
*)
{$I SDGRAF.INC}
{$I SDKEY.INC}
{$I SDTIME.INC}
{$I SDFILE.INC}
{$I SDDISP.INC}
{$I SDMISC.INC}
{$I SDSORT01.INC}
{$I SDSORT02.INC}
{$I SDSORT03.INC}
{$I SDSORT04.INC}
{$I SDSORT05.INC}
{$I SDSORT06.INC}
{$I SDSORT07.INC}
(*─────────────────────────────────────────────────────────────────────────*)
(*
╔═══════════════════════════════════════════════════════════════════════════╗
║ INITIALIZATION ROUTINES ║
╚═══════════════════════════════════════════════════════════════════════════╝
*)
procedure Initialize (var Info : InfoType;
var DefaultPalette : PaletteType;
var Palette : PaletteType;
var OldExitProc : pointer);
begin (* Initialize *)
Randomize;
InitMode13h;
InitFonts;
InitExitProc(OldExitProc);
InitPalettes(DefaultPalette, Palette);
InitList(Info);
TitleScreen;
end; (* Initialize *)
(*
╔═══════════════════════════════════════════════════════════════════════════╗
║ MAIN ROUTINES ║
╚═══════════════════════════════════════════════════════════════════════════╝
*)
procedure Run (var Info : InfoType;
DefaultPalette : PaletteType);
var
StartTD : TimeDateType;
StopTD : TimeDateType;
Diff : DiffType;
(*───────────────────────────────────────────────────────────────────────*)
procedure CallSort (var Info : InfoType;
var Start : TimeDateType;
var Stop : TimeDateType;
var Diff : DiffType);
begin (* CallSort *)
ShowArray(Info);
GetTimeDate(Start);
case Info.Method of
Bubble : BubbleSort(Info);
ShortBubble : ShortBubbleSort(Info);
Selection : SelectionSort(Info);
Merge : MergeSort(Info, 1, Info.Len);
Quick1 : QuickSort1(Info, 1, Info.Len);
Quick2 : QuickSort1(Info, 1, Info.Len);
Heap : HeapSort(Info);
end; (* case *)
GetTimeDate(Stop);
Beep;
CalcTimeDateDifference(Start,Stop,Diff);
FlushAndWait;
end; (* CallSort *)
(*───────────────────────────────────────────────────────────────────────*)
procedure Terminate ( DefaultPalette : PaletteType);
begin (* Terminate *)
SetRGBPalette(DefaultPalette);
Halt(0);
end; (* Terminate *)
(*───────────────────────────────────────────────────────────────────────*)
begin (* Run *)
repeat
Menu(Info);
case Info.Operation of
Mix : MixArray(Info);
Sort : begin
CallSort(Info, StartTD, StopTD, Diff);
ShowAnalysis(Info, StartTD, StopTD, Diff);
end;
Quit : Terminate(DefaultPalette);
end; (* case *)
until true = false;
end; (* Run *)
(*═════════════════════════════════════════════════════════════════════════*)
begin (* SortDemo / main *)
Initialize(Info, DefaultPalette, Palette, OldExitProc);
Run(Info, DefaultPalette);
end. (* SortDemo / main *)